Business Shareware

home *** CD-ROM | disk | FTP | other *** search

/ Business Shareware / Business Shareware.iso / start / database / lib194 / convert.prg < prev next >

Wrap

Text File | 1992-12-23 | 51.8 KB | 1,346 lines

*------------------------------------------------------------------------------- *-- Program...: CONVERT.PRG *-- Programmer: Ken Mayer (CIS: 71333,1030) *-- Date......: 12/04/1992 *-- Notes.....: This is a complete overhaul of the CONVERT program in LIBxxx.ZIP *-- Jay went through it and did massive work ... *-- For details on this file (and others in the library) see *-- README.TXT. *------------------------------------------------------------------------------- FUNCTION Roman *------------------------------------------------------------------------------- *-- Programmer..: Nick Carlin *-- Date........: 04/26/1992 *-- Notes.......: A function designed to return a Roman Numeral based on *-- an Arabic Numeral input ... *-- Written for.: dBASE III+ *-- Rev. History: 04/13/1988 - original function. *-- 07/25/1991 - Ken Mayer - 1) modified for dBASE IV, 1.1, *-- 2) updated to a function, and 3) the procedure *-- GetRoman was done away with (combined into the *-- function). *-- 04/26/1992 - Jay Parsons - shortened (seriously ...) *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Roman(<nArabic>) *-- Example.....: ? Roman(32) *-- Returns.....: Roman Numeral (character string) equivalent of Arabic numeral *-- passed to it. In example: XXXII *-- Parameters..: nArabic = Arabic number to be converted to Roman *------------------------------------------------------------------------------- parameters nArabic private cLetrs,nCount,nValue,cRoman,cGroup,nMod cLetrs ="MWYCDMXLCIVX" && Roman digits cRoman = "" && this is the returned value nCount = 0 && init counter do while nCount < 4 && loop four times, once for thousands, once && for each of hundreds, tens and singles nValue = mod( int( nArabic / 10 ^ ( 3 - nCount ) ), 10 ) cGroup = substr( cLetrs, nCount * 3 + 1, 3 ) nMod = mod( nValue, 5 ) if nMod = 4 if nValue = 9 && 9 cRoman = cRoman + left( cGroup, 1 ) + right( cGroup, 1 ) else && 4 cRoman = cRoman + left( cGroup, 2 ) endif else if nValue > 4 && 5 - 8 cRoman = cRoman + substr( cGroup, 2, 1 ) endif if nMod > 0 && 1 - 3 and 6 - 8 cRoman = cRoman + replicate( left( cGroup, 1 ), nMod ) endif endif nCount = nCount + 1 enddo && while nCounter < 4 RETURN cRoman *-- EoF: Roman() FUNCTION Arabic *------------------------------------------------------------------------------- *-- Programmer..: Ken Mayer (CIS: 71333,1030) *-- Date........: 04/26/1992 *-- Notes.......: This function converts a Roman Numeral to an arabic one. *-- It parses the roman numeral into an array, and checks each *-- character ... if the previous character causes the value to *-- subtract (for example, IX = 9, not 10) we subtract that value, *-- and then set the previous value to 0, otherwise we would get *-- some odd values in return. *-- So far, it works fine. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 07/15/1991 - original function. *-- 04/26/1992 - Jay Parsons - shortened. *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Arabic(<cRoman>) *-- Example.....: ?Arabic("XXIV") *-- Returns.....: Arabic number (from example, 24) *-- Parameters..: cRoman = character string containing roman numeral to be *-- converted. *------------------------------------------------------------------------------- parameters cRoman private cRom,cLetrs,nLast,nAt,nVal,cChar,nArabic cRom = ltrim(trim(upper(cRoman))) && convert to all caps in case ... cLetrs = "IVXLCDMWY" nArabic = 0 nLast = 0 do while len( cRom ) > 0 cChar = right( cRom, 1 ) nAt = at( cChar, cLetrs ) nVal= 10 ^ int( nAt/2 ) / iif(nAt/2 = int(nAt/2),2,1) do case case nAt = 0 nArabic = 0 exit case nAt >= nLast nArabic = nArabic + nVal nLast = nAt otherwise if nAt/2 = int( nAt / 2 ) nArabic = 0 exit else nArabic = nArabic - nVal endif endcase cRom = left( cRom, len( cRom ) - 1 ) enddo RETURN nArabic *-- EoF: Arabic() FUNCTION Factorial *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Factorial of a number; returns -1 if number is not a *-- positive integer. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Factorial(<nNumber>) *-- Example.....: ? Factorial( 6 ) *-- Returns.....: Numeric = number factorial <in example, 6! or 720> *-- Parameters..: nNumber = number for which factorial is to be determined *------------------------------------------------------------------------------- parameters nNumber private nNext, nProduct if nNumber # int( nNumber ) .or. nNumber < 1 RETURN -1 endif nProduct = 1 nNext = nNumber do while nNext > 1 nProduct = nProduct * nNext nNext = nNext - 1 enddo RETURN nProduct *-- Eof: Factorial() FUNCTION IsPrime *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 08/11/1992 *-- Notes.......: Returns .t. if argument is prime positive integer, or .f. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 03/11/92 - original function. *-- : 08/11/92 - revised to return .T. for 2. ( Tea for two? ) *-- Calls.......: None *-- Called by...: Any *-- Usage.......: IsPrime(<nNumber>) *-- Example.....: ? IsPrime( 628321 ) *-- Returns.....: Logical = .t. if prime *-- Parameters..: nNumber = positive integer to test for being prime *------------------------------------------------------------------------------- parameters nNumber private nFactor, nLimit, lResult if nNumber < 1 .or. nNumber # int( nNumber ) ; .or. ( nNumber > 2 .AND. mod( nNumber, 2 ) = 0 ) RETURN .f. endif nFactor = 3 nLimit = sqrt( nNumber ) lResult = .t. do while nFactor <= nLimit if mod( nNumber, nFactor ) = 0 lResult = .f. exit endif nFactor = nFactor + 2 enddo RETURN lResult *-- Eof: IsPrime() FUNCTION BankRound *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Rounds numeric argument to given number of places, *-- which if positive are decimal places, otherwise *-- trailing zeroes before the decimal, in accordance *-- with the special banker's rule that if the value *-- lost by rounding is exactly halfway between two *-- possible digits, the final digit expressed will be even. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: BankRound(<nNumber>,<nPlaces>) *-- Example.....: ? BankRound( 357.725, 2 ) *-- Returns.....: Numeric = rounded value ( 357.72 in example ) *-- Parameters..: nNumber = numeric value to round *-- nPlaces = decimal places, negative being powers of 10 *------------------------------------------------------------------------------- parameters nNumber, nPlaces private nTemp nTemp = nNumber * 10 ^ nPlaces +.5 if nTemp = int( nTemp ) .and. nTemp / 2 # int( nTemp / 2 ) nTemp = nTemp - 1 endif RETURN int( nTemp ) / 10 ^ nPlaces *-- Eof: BankRound() FUNCTION Num2Str *------------------------------------------------------------------------------- *-- Programmer..: Angus Scott-Fleming (CIS: 75500,3223) *-- Date........: 06/09/1992 *-- Notes.......: Converts a number to a string like str(), but uses *-- the ASCII 1/2 and 1/4 characters instead of decimals *-- where appropriate. Does not require knowing the number of *-- decimal places first. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 06/09/1992 -- Angus took Jay's routine and overhauled it. *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Num2Str(<nNumber>) *-- Example.....: ? Num2Str( 415.25 ) *-- Returns.....: Character = representation of number ( "415.25" in example ) *-- Parameters..: nNumber = number to represent *------------------------------------------------------------------------------- parameters nNumber private nInteger, nFraction, cFracstr, nDec nInteger = int( nNumber ) nFraction = abs( nNumber - nInteger ) if nFraction = 0 cFracStr = "" else *-- note that the maximum # of decimals is 18 cFracStr = ltrim(str(nFraction,19,18)) do while right(cFracStr,1) = "0" cFracstr = left(cFracStr,len(cFracStr)-1) enddo endif RETURN ltrim( str( nInteger ) ) + cFracstr *-- Eof: Num2Str() FUNCTION Dec2Hex *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts an unsigned integer ( in decimal notation) *-- to a hexadecimal string *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Dec2Hex(<nDecimal>) *-- Example.....: ? Dec2Hex( 118 ) *-- Returns.....: Character = Hexadecimal equivalent ( "F6" in example ) *-- Parameters..: nDecimal = number to convert *------------------------------------------------------------------------------- parameters nDecimal private nD, cH nD = int( nDecimal ) cH= "" do while nD > 0 cH = substr( "0123456789ABCDEF", mod( nD, 16 ) + 1 , 1 ) + cH nD = int( nD / 16 ) enddo RETURN iif( "" = cH, "0", cH ) *-- Eof: Dec2Hex() FUNCTION Hex2Dec *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/26/1992 *-- Notes.......: Converts a hexadecimal character string representing *-- an unsigned integer to its numeric (decimal) equivalent *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 03/01/92 - original function. *-- 11/26/92 - modified to eliminate usually-harmless *-- "substring out of range" error, Jay Parsons *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Hex2Dec(<cHex>) *-- Example.....: ? Hex2Dec( "F6" ) *-- Returns.....: Numeric = equivalent ( 118 in example ) *-- Parameters..: cHex = character string to convert *------------------------------------------------------------------------------- parameters cHex private nD, cH cH = upper( trim( ltrim ( cHex ) ) ) + "!" nD = 0 do while len( cH ) > 1 nD = nD * 16 + at( left( cH, 1 ), "123456789ABCDEF" ) cH = substr( cH, 2 ) enddo RETURN nD *-- Eof: Hex2Dec() FUNCTION Hex2Bin *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 12/01/1992 *-- Notes.......: Converts a hexadecimal character string representing *-- an unsigned integer to its binary string equivalent *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 03/01/92 - original function. *-- 12/01/92 - modified to eliminate usually-harmless *-- "substring out of range" error, Jay Parsons *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Hex2Bin(<cHex>) *-- Example.....: ? Hex2Bin( "F6" ) *-- Returns.....: Character = binary string ( "1111 0110" in example ) *-- Parameters..: cHex = character string to convert *------------------------------------------------------------------------------- parameters cHex private cH, cBits, cNybbles, cVal cH = upper( trim( ltrim( cHex ) ) ) + "!" cBits = "" cNybbles = "00000001001000110100010101100111" ; +"10001001101010111100110111101111" do while len( cH ) > 1 cVal = left( cH, 1 ) if cVal # " " cBits = cBits + " " + substr( cNybbles, ; at ( cVal, "123456789ABCDEF" ) * 4 + 1, 4 ) endif cH = substr( cH, 2 ) enddo RETURN iif( "" = cBits, "0", ltrim( cBits ) ) *-- Eof: Hex2Bin() FUNCTION Bin2Hex *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts a binary character string representing *-- an unsigned integer to its hexadecimal string equivalent *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Bin2Hex(<cBin>) *-- Example.....: ? Bin2Hex( "1111 0110" ) *-- Returns.....: Character = hexadecimal string ( "F6" in example ) *-- Parameters..: cBin = character string to convert *------------------------------------------------------------------------------- parameters cBin private cH, cBits, nBits, nBval, cNext cBits = trim( ltrim( cBin ) ) nBits = len( cBits ) - 1 do while nBits > 0 if substr( cBits, nBits, 1 ) $ ", " nBval = mod( 4 - mod( len( cBits ) - nBits, 4 ), 4 ) cBits = stuff( cBits, nBits, 1, replicate( "0", nBval ) ) endif nBits = nBits - 1 enddo cH = "" do while "" # cBits store 0 to nBits, nBval do while nBits < 4 cNext = right( cBits, 1 ) nBval = nBval + iif( cNext = "1", 2 ^ nBits, 0 ) cBits = left( cBits, len( cBits ) - 1 ) if "" = cBits exit endif nBits = nBits + 1 enddo cH = substr( "0123456789ABCDEF", nBval + 1, 1 ) + cH enddo RETURN iif( "" = cH, "0", cH ) *-- Eof: Bin2Hex() FUNCTION Dec2Oct *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts an unsigned integer to its octal string equivalent *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Dec2Oct(<nDec>) *-- Example.....: ? Dec2Oct( 118 ) *-- Returns.....: Character = octal string ( "166" in example ) *-- Parameters..: nDec = number to convert *------------------------------------------------------------------------------- parameters nDec private nD, cO nD = int( nDec ) cO = "" do while nD > 0 cO = substr( "01234567", mod( nD, 8 ) + 1 , 1 ) + cO nD = int( nD / 8 ) enddo RETURN iif( "" = cO, "0", cO ) *-- Eof: Dec2Oct() FUNCTION Oct2Dec *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 12/01/1992 *-- Notes.......: Converts an unsigned number in octal, or its string *-- representation, to a numeric (decimal) value *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 03/01/92 - original function. *-- 12/01/92 - modified to eliminate usually-harmless *-- "substring out of range" error, Jay Parsons *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Oct2Dect(<xOct>) *-- Example.....: ? Oct2Dec( 166 ) *-- Returns.....: Numeric = decimal equivalent ( 118 in example ) *-- Parameters..: xOct = octal character string or number to convert *------------------------------------------------------------------------------- parameters xOct private nD, cO, cVal if type( "xOct" ) $ "NF" cO = str( xOct ) else cO = xOct endif cO = upper( trim( ltrim( cO ) ) ) + "!" nD = 0 do while len( cO ) > 1 cVal = left( cO, 1 ) if cVal # " " nD = nD * 8 + at( cVal, "1234567" ) endif cO = substr( cO, 2 ) enddo RETURN nD *-- Eof: Oct2Dec() FUNCTION Cash2Check *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts a number of dollars and cents to a string of words *-- appropriate for writing checks. *-- To correctly evaluate values over 16 decimal places, *-- SET PRECISION TO a value larger than the default of 16 *-- before calling this function. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: NUM2WORDS() Function in CONVERT.PRG *-- THOU2WORDS() Function in CONVERT.PRG *-- Called by...: Any *-- Usage.......: Cash2Check(<nCash>) *-- Example.....: ? Cash2Check( 348.27 ) *-- Returns.....: Character string equivalent *-- Parameters..: nCash = money value to convert *------------------------------------------------------------------------------- parameters nCash private nDollars, nCents, cResult nDollars = int( nCash ) nCents = 100 * round( nCash - nDollars, 2 ) cResult = trim( Num2Words( nDollars ) ) if left( cResult, 1 ) = "C" && deals with oversize number RETURN cResult endif cResult = cResult + " dollar" + iif( nDollars # 1, "s", "" ) + " and " if nCents # 0 RETURN cResult + Thou2Words( nCents ) + " cent" + iif( nCents # 1, "s", "" ) else RETURN cResult + "no cents" endif *-- Eof: Cash2Check() FUNCTION Num2Words *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts an integer to a string of words. Limited, due to *-- 254-character limit of dBASE strings, to numbers less than *-- 10 ^ 15 *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: THOU2WORDS() Function in CONVERT.PRG *-- Called by...: Any *-- Usage.......: Num2Words(<nNum>) *-- Example.....: ? Num2Words( 4321568357 ) *-- Returns.....: Character string equivalent *-- Parameters..: nNum = numeric integer to convert *------------------------------------------------------------------------------- parameters nNum private nNumleft, nScale, nGroup, cResult nNumleft = int( nNum ) do case case abs( nNumleft ) >= 10 ^ 15 RETURN "Cannot convert a number in or above the quadrillions." case nNumleft = 0 RETURN "zero" case nNumleft < 0 cResult = "minus " nNumleft = -nNumleft otherwise cResult = "" endcase do while nNumleft > 0 nScale = int( log10( nNumleft ) / 3 ) nGroup = int( nNumleft / 10 ^ ( 3 * nScale ) ) nNumleft = mod( nNumleft, 10 ^ ( 3 * nScale ) ) cResult = cResult + Thou2Words( nGroup ) if nScale > 0 cResult = cResult + " " ; + trim( substr( "thousandmillion billion trillion", nScale * 8 - 7, 8 ) ) if nNumleft > 0 cResult = cResult + ", " endif endif enddo RETURN cResult *-- Eof: Num2Words() FUNCTION Thou2Words *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts a positive integer less than 1000 to a string *-- of characters. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Thou2Words(<nNum>) *-- Example.....: ? Thou2Words( 834 ) *-- Returns.....: Character string equivalent *-- Parameters..: nNum = numeric integer to convert *------------------------------------------------------------------------------- parameters nNum private cUnits, cTens, nN, cResult cUnits = "one two " ; + "three four " ; + "five six " ; + "seven eight " ; + "nine ten " ; + "eleven twelve " ; + "thirteen fourteen " ; + "fifteen sixteen " ; + "seventeeneighteen " ; + "nineteen " cTens = "twen thir for fif six seveneigh nine " nN = int( nNum ) if nN = 0 RETURN "zero" endif cResult = "" if nNum > 99 cResult = trim( substr(cUnits, int(nNum / 100 ) * 9 - 8, 9 ) ) + " hundred" nN = mod( nN, 100 ) if nN = 0 RETURN cResult else cResult = cResult + " " endif endif if nN > 19 cResult = cResult + trim( substr( cTens, int( nN / 10 ) * 5 - 9, 5 ) ) + "ty" nN = mod( nN, 10 ) if nN = 0 RETURN cResult else cResult = cResult + "-" endif endif RETURN cResult + trim( substr( cUnits, nN * 9 - 8, 9 ) ) *-- Eof: Thou2Words() FUNCTION Ord *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts an integer to ordinal representation by adding *-- "st", "nd", "rd" or "th" after its digit(s) *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Ord(<nNum>) *-- Example.....: ? Ord( 11 ) *-- Returns.....: Character ordinal string equivalent ( "11th" in example ) *-- Parameters..: nNum = numeric integer to convert *------------------------------------------------------------------------------- parameters nNum private nD nD = mod( nNum, 100 ) - 1 && the -1 just happens to simplify what follows RETURN str( nNum ) + iif( mod( nD, 10 ) > 2 .or. abs( nD - 11 ) < 2, ; "th", substr( "stndrd", mod( nD, 10 ) * 2 + 1, 2 ) ) *-- Eof: Ord() FUNCTION Dec2Bin *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts an unsigned number to a character *-- string giving its ASCII binary representation. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Dec2Bin(<nNum>,<nPlaces>) *-- Example.....: ? Dec2Bin( 35, 8 ) *-- Returns.....: Character binary equivalent ( "0010 0011", in example ) *-- Parameters..: nNum = number to convert *-- nPlaces = number of binary places number is to occupy *------------------------------------------------------------------------------- parameters nNum, nPlaces private cBits, nN cBits= "" nN = nNum do while len(cBits) < nPlaces if nN > 0 cBits = str( mod( nN, 2 ), 1 ) + cBits nN = int( nN / 2 ) else cBits = "0" +cBits endif enddo RETURN cBits *-- Eof: Dec2Bin() FUNCTION Frac2Bin *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 03/01/1992 *-- Notes.......: Converts the fractional part of an unsigned number *-- to a character string giving its ASCII binary representation. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: None *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Frac2Bin(<nNum>,<nPlaces>) *-- Example.....: ? Frac2Bin( .35, 8 ) *-- Returns.....: Character binary equivalent *-- Parameters..: nNum = number to convert *-- nPlaces = number of binary places number is to occupy *------------------------------------------------------------------------------- parameters nNum, nPlaces private cBits, nN cBits = "" nN = nNum do while len( cBits ) < nPlaces if nN > 0 nN = 2 * nN cBits = cBits + str( int( nN ), 1 ) nN = nN - int( nN ) else cBits = cBits + "0" endif enddo RETURN cBits *-- Eof: Frac2Bin() FUNCTION Num2Real *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/26/1992 *-- Notes.......: Converts a number to the ASCII representation of *-- its storage in IEEE 4 or 8-byte real format, with least *-- significant byte (lowest in memory) first. Provided *-- for checking the values in .MEM files, or in memory *-- float-type variables if peeking. *-- Written for.: dBASE IV Version 1.5 *-- ( may be adapted to earlier versions by requiring fixed *-- number of parameters.) *-- Rev. History: 03/01/92 - original function *-- 11/26/92 - revised to call Dec2Mkd(), etc., Jay Parsons *-- The parameters of the revised version are not the same *-- as those of the original. *-- Calls.......: Dec2Mkd() Function in CONVERT.PRG *-- Dec2Mks() Function in CONVERT.PRG *-- Dec2Hex() Function in CONVERT.PRG *-- Called by...: Any *-- Usage.......: Num2Real(<nNum> [,<nBytes>] ) *-- Example.....: ? Num2Real( 10E100, 8 ) *-- Returns.....: Character string equivalent ( of a blank date, in example ) *-- Parameters..: nNum = number to convert *-- nBytes = number of bytes in conversion. Optional, *-- will be considered 8 ( long real ) unless *-- 4 is specified. *------------------------------------------------------------------------------- parameters nNum, nBytes private cStr, nB, nX, MK nB = iif( type( "nBytes" ) = "N" .AND. nBytes = 4, 4, 8 ) declare MK[ nB ] cStr = "" if "" # iif( nB = 8, Dec2Mkd( nNum, "MK" ), Dec2Mks( nNum, "MK" ) ) nX = 1 do while nX <= nB cNext = Dec2Hex( asc( MK[ nX ] ) ) cStr = cStr + right( "0" + Dec2Hex( asc( MK[ nX ] ) ), 2 ) + " " nX = nX + 1 enddo endif RETURN trim( cStr ) *-- Eof: Num2Real() FUNCTION Bin2Dec *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/25/1992 *-- Notes.......: Converts a string containing a binary value *-- to its numeric (decimal) equivalent. Any characters *-- in the string other than "0" or "1" are ignored. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/25/92, original function *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Bin2Dec( <cStr ) *-- Example.....: ? Bin2Dec( "1000 0011" ) *-- Returns.....: Numeric = equivalent ( 131 in example ) *-- Parameters..: cStr1 = string holding binary value to convert *------------------------------------------------------------------------------- parameters cStr private cLeft, cChar, nVal nVal = 0 cLeft = cStr + "!" do while len( cLeft ) > 1 cChar = left( cLeft, 1 ) cLeft = substr( cLeft, 2 ) if cChar $ "01" nVal = 2 * nVal + val( cChar ) endif enddo RETURN nVal *-- Eof: Bin2Dec() FUNCTION Dec2Mkd *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/26/1992 *-- Notes.......: Converts a numeric value to eight chr() values in array. *-- See notes to Dec2Mki(). *-- Returns null string if array not declared or declared *-- with too few elements. *-- This is roughly equivalent to MKD$() in BASIC. *-- Concatenation of the array elements gives the value *-- in IEEE long real format ( low-order byte first.) *-- From high to low, the 64 bits are: *-- 1 bit sign, 1 = negative *-- 11 bits exponent base 2 + 1023 *-- 23 bits mantissa with initial "1." omitted as *-- understood. *-- dBASE uses this format for floats and dates internally *-- and in .MEM files; obviously, the dBASE float() function *-- will make the same conversion more quickly, but creates *-- difficulties in accessing the bytes as converted. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/26/92, original function *-- Calls.......: Bin2Dec() - Function in Convert.prg *-- Dec2Bin() - Function in Convert.prg *-- Frac2Bin() - Function in Convert.prg *-- Called by...: Any *-- Usage.......: Dec2Mkd( nVar, cName ) *-- Example.....: ? Dec2Mkd( -1, "MK" ) *-- Returns.....: name of array of which elements [ 1 ] - [ 8 ] contain *-- chr() values equivalent to bytes of value; or null string. *-- Parameters..: nVar = number to convert *-- cName = name of array to use, which must be public and *-- previously declared with enough elements *-- Side effects: Alters contents of array *------------------------------------------------------------------------------- parameters nVar, cName private cStr, cBin, nVal, nExp, nMant, nX cStr = "" if type( "&cName.[ 8 ]" ) # "U" cStr = cName if nVar = 0 nX = 1 do while nX < 9 &cStr.[ nX ] = chr( 0 ) nX = nX + 1 enddo else cBin = iif( nVar < 0, "1", "0" ) nVal = abs( nVar ) nExp = int( log( nVar ) / log( 2 ) ) nMant = nVal / 2 ^ nExp - 1 cBin = cBin + Dec2Bin( nExp + 1023, 11 ) + Frac2Bin( nMant, 52 ) nX = 1 do while nX < 9 &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 65 - nX * 8, 8 ) ) ) nX = nX + 1 enddo endif endif RETURN cStr *-- EoF: Dec2Mkd() FUNCTION Dec2Mki *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/26/1992 *-- Notes.......: Converts an integer in the range -32,768 to +32,767 *-- to two chr() values equivalent to the two bytes created *-- by the BASIC MKI$ function. *-- Because of the impossibility of storing a null, *-- chr( 0 ), as a character in a dBASE string, the chr() *-- values are stored in the first two elements of an array, *-- with the low-order byte as element[ 1 ]. Array name must *-- be passed as second parameter. Array name will *-- be returned unless the parameter is out of range or *-- array has too few elements, in which case the null *-- string is returned. *-- Concatenation of the array elements such as by *-- fwrite( <nHandle>,<Arrayname>[ 1 ] ) *-- fwrite( <nHandle>,<Arrayname>[ 2 ] ) *-- writes the same value as the BASIC MKI$ function. *-- The same format is used by dBASE for internal storage *-- of integers within the range, and by C as a signed int. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/26/92, original function *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Dec2Mki( nInt, cName ) *-- Example.....: ? Dec2Mki( -1, "MK" ) *-- Returns.....: name of array of which elements contain char equivalents, *-- chr( 255) and chr( 255 ) in example; or null string. *-- Parameters..: nInt = integer to convert *-- cName = name of array to use, which must be public and *-- previously declared with enough elements *-- Side effects: Alters contents of array *------------------------------------------------------------------------------- parameters nInt, cName private nVal, cStr, nX cStr = "" if type( "&cName.[ 2 ]" ) # "U" cStr = cName if nInt = int( nInt ) .AND. nInt >= -32768 .AND. nInt <= 32767 nVal = nInt + iif( nInt < 0, 65536, 0 ) nX = 1 do while nX < 3 &cStr.[ nX ] = chr( mod( nVal, 256 ) ) nVal = int( nVal / 256 ) nX = nX + 1 enddo endif endif RETURN cStr *-- EoF: Dec2Mki() FUNCTION Dec2Mkl *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/26/1992 *-- Notes.......: Converts an integer in the range -2^31 to +2^31 - 1 *-- to four chr() values in array. See notes to Dec2Mki(). *-- Returns null string if parameter is out of range or *-- array not declared or declared with too few elements. *-- This is mostly equivalent to MKL$() in BASIC. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/26/92, original function *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Dec2Mkl( nInt, cName ) *-- Example.....: ? Dec2Mkl( -1, "MK" ) *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain *-- chr() values equivalent to bytes of value; or null string. *-- Parameters..: nInt = integer to convert *-- cName = name of array to use, which must be public and *-- previously declared with enough elements *-- Side effects: Alters contents of array *------------------------------------------------------------------------------- parameters nInt, cName private nVal, cStr, nX cStr = "" if type( "&cName.[ 4 ]" ) # "U" cStr = cName if nInt = int( nInt ) .AND. nInt >= -2 ^ 31 .AND. nInt < 2 ^ 31 nVal = nInt + iif( nInt < 0, 2 ^ 32, 0 ) nX = 1 do while nX < 5 &cStr.[ nX ] = chr( mod( nVal, 256 ) ) nVal = int( nVal / 256 ) nX = nX + 1 enddo endif endif RETURN cStr *-- EoF: Dec2Mkl() FUNCTION Dec2Mks *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/26/1992 *-- Notes.......: Converts a numeric value to four chr() values in array. *-- See notes to Dec2Mki(). *-- Returns null string if array not declared or declared *-- with too few elements. *-- This is mostly equivalent to MKS$() in BASIC. *-- Concatenation of the array elements gives the value *-- in IEEE short real format ( low-order byte first.) *-- From high to low, the 32 bits are: *-- 1 bit sign, 1 = negative *-- 8 bits exponent base 2 + 127 *-- 23 bits mantissa with initial "1." omitted as *-- understood. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/26/92, original function *-- Calls.......: Bin2Dec() - Function in Convert.prg *-- Dec2Bin() - Function in Convert.prg *-- Frac2Bin() - Function in Convert.prg *-- Called by...: Any *-- Usage.......: Dec2Mks( nVar, cName ) *-- Example.....: ? Dec2Mks( -1, "MK" ) *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain *-- chr() values equivalent to bytes of value; or null string. *-- Parameters..: nVar = number to convert *-- cName = name of array to use, which must be public and *-- previously declared with enough elements *-- Side effects: Alters contents of array *------------------------------------------------------------------------------- parameters nVar, cName private cStr, cBin, nVal, nExp, nMant, nX cStr = "" if type( "&cName.[ 4 ]" ) # "U" cStr = cName if nVar = 0 nX = 1 do while nX < 5 &cStr.[ nX ] = chr( 0 ) nX = nX + 1 enddo else cBin = iif( nVar < 0, "1", "0" ) nVal = abs( nVar ) nExp = int( log( nVar ) / log( 2 ) ) nMant = nVal / 2 ^ nExp - 1 cBin = cBin + Dec2Bin( nExp + 127, 8 ) + Frac2Bin( nMant, 23 ) nX = 1 do while nX < 5 &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 33 - nX * 8, 8 ) ) ) nX = nX + 1 enddo endif endif RETURN cStr *-- EoF: Dec2Mks() FUNCTION Dec2MSks *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 12/01/1992 *-- Notes.......: Converts a numeric value to four chr() values in array. *-- See notes to Dec2Mki(). USES OBSOLETE MICROSOFT FORMAT. *-- Returns null string if array not declared or declared *-- with too few elements. *-- This is mostly equivalent to MKS$() in old Microsoft BASIC. *-- Concatenation of the array elements gives the value *-- as stored in old MicroSoft four-byte real format. *-- From high to low, the 32 bits are: *-- 8 bits exponent base 2 + 128 *-- 1 bit sign, 1 = negative *-- 23 bits mantissa with initial ".1" omitted as *-- understood. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 12/01/92, original function *-- Calls.......: Bin2Dec() - Function in Convert.prg *-- Dec2Bin() - Function in Convert.prg *-- Frac2Bin() - Function in Convert.prg *-- Called by...: Any *-- Usage.......: Dec2MSks( nVar, cName ) *-- Example.....: ? Dec2MSks( -1, "MK" ) *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain *-- chr() values equivalent to bytes of value; or null string. *-- Parameters..: nVar = number to convert *-- cName = name of array to use, which must be public and *-- previously declared with enough elements *-- Side effects: Alters contents of array *------------------------------------------------------------------------------- parameters nVar, cName private cStr, cBin, nVal, nExp, nMant, nX cStr = "" if type( "&cName.[ 4 ]" ) # "U" cStr = cName if nVar = 0 nX = 1 do while nX < 5 &cStr.[ nX ] = chr( 0 ) nX = nX + 1 enddo else cBin = iif( nVar < 0, "1", "0" ) nVal = abs( nVar ) nExp = int( log( nVar ) / log( 2 ) ) nMant = nVal / 2 ^ nExp - 1 cBin = Dec2Bin( nExp + 129, 8 ) + cBin + Frac2Bin( nMant, 23 ) nX = 1 do while nX < 5 &cStr.[ nX ] = chr( Bin2Dec( substr( cBin, 33 - nX * 8, 8 ) ) ) nX = nX + 1 enddo endif endif RETURN cStr *-- EoF: Dec2MSks() FUNCTION Mkd2Dec *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/26/1992 *-- Notes.......: Converts eight bytes storing an IEEE long real value *-- ( as saved by the BASIC MKD$ function, e. g. ) *-- to its numeric (decimal) equivalent. As usual, the *-- eight bytes of the value are stored low-order to high- *-- order, and are expected as parameters in that order. *-- From high to low, the 64 bits are: *-- 1 bit sign, 1 = negative *-- 11 bits exponent base 2 + 1023 *-- 52 bits mantissa with initial "1." omitted as *-- understood. *-- The function is written to require eight separate *-- parameters rather than an eight-character string because *-- fread() will choke on reading the value as a single *-- string if it contains nulls ( chr( 0 ) ). *-- This is the equivalent of CVD() in BASIC. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/26/92 - original function *-- Calls.......: Bin2Dec() - Function in Convert.prg *-- Called by...: Any *-- Usage.......: Mkd2Dec( <c1>, . . . <c8> ) *-- Example.....: ? Mkd2Dec( chr( 0 ), chr( 0 ), chr( 0 ), chr( 0 ), ; *-- chr( 0 ), chr( 0 ), chr( 248 ), chr( 3 ) *-- Returns.....: Numeric = equivalent ( 1 in example ) *-- Parameters..: c1 . . . c8 = chars holding value to convert *------------------------------------------------------------------------------- parameters c1, c2, c3, c4, c5, c6, c7, c8 private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal, nZ nX = 8 nZ = 0 cBin = "" do while nX > 0 cVar = "c" + str( nX, 1 ) nVal = asc( &cVar ) nZ = nZ + nVal nY = 7 do while nY >=0 cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" ) nVal = mod( nVal, 2 ^ nY ) nY = nY - 1 enddo nX = nX - 1 enddo if nZ = 0 nVal = 0 else nSign = iif( left( cBin, 1 ) = "1", -1, 1 ) nExp = Bin2Dec( substr( cBin, 2, 11) ) - 1023 cMant = "1" + right( cBin, 52 ) nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 52 ) * nSign endif RETURN nVal *-- EoF: Mkd2Dec() FUNCTION Mki2Dec *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/25/1992 *-- Notes.......: Converts two bytes storing a signed short integer *-- ( as saved by the BASIC MKI$ function, e. g. ) *-- to its numeric (decimal) equivalent. The format *-- accommodates values from 8000 ( -32,768 ) to *-- 7FFF ( +32,767 ); the low-order byte is stored first *-- and is expected as the first parameter. *-- This is the equivalent of CVI() in BASIC. *-- While this could easily be modified to accept *-- a two-character string as the parameter, dBASE and *-- particularly fread() will have trouble with such a *-- string that contains a null ( chr( 0 ) ). *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/25/92, original function *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Mki2Dec( <c1>, <c2> ) *-- Example.....: ? Mki2Dec( chr( 255 ), chr( 255 ) ) *-- Returns.....: Numeric = equivalent ( -1 in example ) *-- Parameters..: c1, c2 = chars holding value to convert *------------------------------------------------------------------------------- parameters c1, c2 private nVal nVal = asc( c1 ) + 256 * asc( c2 ) if nVal > 32767 nVal = nVal - 65536 endif RETURN nVal *-- EoF: Mki2Dec() FUNCTION Mkl2Dec *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/26/1992 *-- Notes.......: Converts four bytes storing a signed long integer *-- ( as saved by the BASIC MKL$ function, e. g. ) *-- to its numeric (decimal) equivalent. The low-order *-- byte is stored first and is expected as the first *-- parameter. *-- This is the equivalent of CVL() in BASIC. *-- While this could easily be modified to accept *-- a four-character string as the parameter, dBASE and *-- particularly fread() will have trouble with such a *-- string that contains a null ( chr( 0 ) ). *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/26/92, original function *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Mkl2Dec( <c1>, <c2>, <c3>, <c4> ) *-- Example.....: ? Mkl2Dec( chr( 255 ), chr( 255 ), chr(255 ), chr( 255) ) *-- Returns.....: Numeric = equivalent ( -1 in example ) *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert *------------------------------------------------------------------------------- parameters c1, c2, c3, c4 private nVal, nX, cVar nVal = 0 nX = 4 do while nX > 0 cVar = "c" + str( nX, 1 ) nVal = 256 * nVal + asc( &cVar ) nX = nX - 1 enddo if nVal >= 2 ^ 31 nVal = nVal - 2 ^ 32 endif RETURN nVal *-- EoF: Mkl2Dec() FUNCTION Mks2Dec *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/25/1992 *-- Notes.......: Converts four bytes storing an IEEE short real value *-- ( as saved by the BASIC MKS$ function, e. g. ) *-- to its numeric (decimal) equivalent. As usual, the *-- four bytes of the value are stored low-order to high- *-- order, and are expected as parameters in that order. *-- From high to low, the 32 bits are: *-- 1 bit sign, 1 = negative *-- 8 bits exponent base 2 + 127 *-- 23 bits mantissa with initial "1." omitted as *-- understood. *-- The function is written to require four separate *-- parameters rather than a four-character string because *-- fread() will choke on reading the value as a single *-- string if it contains nulls ( chr( 0 ) ). *-- This is the equivalent of CVS() in BASIC. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/25/92, original function *-- Calls.......: Bin2Dec() - Function in Convert.prg *-- Called by...: Any *-- Usage.......: Mks2Dec( <c1>, <c2>, <c3>, <c4> ) *-- Example.....: ? Mks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) ) *-- Returns.....: Numeric = equivalent ( 1 in example ) *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert *------------------------------------------------------------------------------- parameters c1, c2, c3, c4 private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal if asc( c1 ) + asc( c2 ) + asc( c3 ) + asc( c4 ) = 0 nVal = 0 else nX = 4 cBin = "" do while nX > 0 cVar = "c" + str( nX, 1 ) nVal = asc( &cVar ) nY = 7 do while nY >=0 cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" ) nVal = mod( nVal, 2 ^ nY ) nY = nY - 1 enddo nX = nX - 1 enddo nSign = iif( left( cBin, 1 ) = "1", -1, 1 ) nExp = Bin2Dec( substr( cBin, 2, 8 ) ) - 127 cMant = "1" + right( cBin, 23 ) nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 23 ) * nSign endif RETURN nVal *-- EoF: Mks2Dec() FUNCTION MSks2Dec *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (CIS: 70160,340) *-- Date........: 11/28/1992 *-- Notes.......: Converts four bytes storing an old-style Microsoft *-- short real value ( as saved by the BASIC MKS$ function, *-- e. g. ) to its numeric (decimal) equivalent. As usual, *-- the four bytes of the value are stored low-order to high- *-- order, and are expected as parameters in that order. *-- From high to low, the 32 bits are: *-- 8 bits exponent base 2 + 128 *-- 1 bit sign, 1 = negative *-- 23 bits mantissa with initial ".1" omitted as *-- understood. *-- The function is written to require four separate *-- parameters rather than a four-character string because *-- fread() will choke on reading the value as a single *-- string if it contains nulls ( chr( 0 ) ). *-- This is the equivalent of CVS() in old Microsoft BASIC. *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/28/92, original function *-- Calls.......: Bin2Dec() - Function in Convert.prg *-- Called by...: Any *-- Usage.......: MSks2Dec( <c1>, <c2>, <c3>, <c4> ) *-- Example.....: ? MSks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) ) *-- Returns.....: Numeric = equivalent ( 1 in example ) *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert *------------------------------------------------------------------------------- parameters c1, c2, c3, c4 private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal if asc( c1 ) + asc( c2 ) + asc( c3 ) + asc( c4 ) = 0 nVal = 0 else nX = 4 cBin = "" do while nX > 0 cVar = "c" + str( nX, 1 ) nVal = asc( &cVar ) nY = 7 do while nY >=0 cBin = cBin + iif( nVal >= 2 ^ nY, "1", "0" ) nVal = mod( nVal, 2 ^ nY ) nY = nY - 1 enddo nX = nX - 1 enddo nSign = iif( substr( cBin, 9, 1 ) = "1", -1, 1 ) nExp = Bin2Dec( left( cBin, 8 ) ) - 128 cMant = "1" + right( cBin, 23 ) nVal = Bin2Dec( cMant ) * 2 ^ ( nExp - 24 ) * nSign endif RETURN nVal *-- EoF: MSks2Dec() FUNCTION Ordinal *------------------------------------------------------------------------------- *-- Programmer..: Jay Parsons (USSBBS, CIS 70160,340) *-- Date........: 12/03/1992 *-- Notes.......: Returns ordinal string for a positive integer < 100. *-- For higher numbers, use Num2Words on int( n/100 ), then *-- use this on mod( n, 100 ) or if mod( n, 100 ) = 0, add "th" ). *-- Written for.: dBASE IV, 1.1 *-- Rev. History: 11/19/1992 - original function *-- 12/03/1992 - Jay Parsons - changed notes and variable names, *-- replaced five lines with an "iif" line *-- Calls.......: None *-- Called by...: Any *-- Usage.......: Ordinal( <nNum> ) *-- Example.....: ? Ordinal( 31 ) && returns "thirty-first" *-- Returns.....: String giving ordinal value ( position ) of number, or null *-- Parameters..: nNum = integer > 0 and < 100 *------------------------------------------------------------------------------- parameters nNum private cUnits, cTeens, cDecades, nRest, cOrd *-- 6 123456123456123456123456123456123456123456123456123456 cUnits = " four fif six seven eigh nin ten eleventwelf " *-- 5 1234512345123451234512345123451234512345 cTeens = " thir four fif six seveneigh nine " cDecades = " twen thir for fif six seveneigh nine" nRest = nNum cOrd = "" if nRest # int( nRet ) .OR. nRest < 1 .OR. nRest > 99 nRest = 0 endif if nRest > 19 cOrd = trim( substr( cDecades, 5 * ( int( nRest / 10 ) - 1 ), 5 ) ) ; + "t" nRest = mod( nRest, 10 ) cOrd = cOrd + iif( nRest = 0, "ieth", "y-" ) endif do case case nRest > 12 cOrd = cOrd + trim( substr( cTeens, 5 * ( nRest - 12 ), 5 ) ) ; + "teenth" case nRest > 3 cOrd = cOrd + trim( substr( cUnits, 6 * ( nRest - 3 ), 6 ) ) + "th" case nRest > 0 cOrd = cOrd ; + trim( substr( " first secondthird ", 6 * nRest, 6 ) ) endcase RETURN cOrd *-- EoF() Ordinal *------------------------------------------------------------------------------- *-- EoP: CONVERT.PRG *-------------------------------------------------------------------------------